Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/tree/tree.frm

Text File | 1995-09-06 | 6KB | 240 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Directory - Sizes"
   ClientHeight    =   6600
   ClientLeft      =   1725
   ClientTop       =   1695
   ClientWidth     =   7275
   Height          =   7005
   Icon            =   TREE.FRX:0000
   Left            =   1665
   LinkTopic       =   "Form1"
   ScaleHeight     =   6600
   ScaleWidth      =   7275
   Top             =   1350
   Width           =   7395
   Begin CommandButton Command1
      Caption         =   "Scan"
      Height          =   315
      Left            =   120
      TabIndex        =   3
      Top             =   180
      Width           =   795
   End
   Begin Outline DirOutline
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Fixedsys"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   5955
      Left            =   120
      PictureClosed   =   TREE.FRX:0302
      PictureLeaf     =   TREE.FRX:045C
      PictureMinus    =   TREE.FRX:05B6
      PictureOpen     =   TREE.FRX:0710
      PicturePlus     =   TREE.FRX:086A
      TabIndex        =   2
      Top             =   540
      Width           =   7035
   End
   Begin DriveListBox Drive1
      Height          =   315
      Left            =   1620
      TabIndex        =   1
      Top             =   180
      Width           =   5535
   End
   Begin Label Label1
      Caption         =   "Drive"
      Height          =   255
      Left            =   1080
      TabIndex        =   0
      Top             =   240
      Width           =   495
   End
End
Dim Anzahl As Integer
Dim Terminate As Integer

Function AddAllInNextLevel (CurrentPath As String, Level As Integer) As Long

    Dim Count, D(), i, DirName  ' Declare variables.
    Dim ATTR_Directory
    Dim Total, GrandTotal, SubTotal As Long
    Dim AnzahlNow As Integer
    Dim Ausgabe As String

    Counter = 0
    Count = 0
    Total = 0
    GrandTotal = 0
    SubTotal = 0
    ATTR_Directory = 16
    ATTR_Normal = 0

    DirName = Dir(CurrentPath + "*.*", ATTR_Directory)' Get first directory name.

    'Iterate through PATH, caching all subdirectories in D()

    Do While DirName <> ""
    If DirName <> "." And DirName <> ".." Then
        If (GetAttr(CurrentPath + DirName) And ATTR_Directory) <> 0 Then
        If (Count Mod 10) = 0 Then
            ReDim Preserve D(Count + 10)    ' Resize the array.
        End If
        Count = Count + 1   ' Increment counter.
        D(Count) = DirName

        End If
    End If
    DirName = Dir   ' Get another directory name.
    Loop

    ' -> Gr÷▀e des aktuellen Verzeichnis bestimmen

    DirName = Dir(CurrentPath + "*.*", 0)' Get first directory name.

    On Error GoTo ErrorHandler

    Do While DirName <> ""
     If (GetAttr(CurrentPath + DirName) And ATTR_Directory) = 0 Then
           Total = Total + FileLen(CurrentPath + DirName)
           Counter = Counter + 1
           If Counter Mod 50 = 0 Then
           Form1.Caption = "Scan: " + CurrentPath & "\ (" + Format(Total / 1024, "#######0") + ")"
           End If
       End If
       DirName = Dir   ' Get another name.
    Loop

    ' Now recursively iterate through each cached subdirectory.

    For i = 1 To Count

       DirOutline.AddItem D(i) ' Put name in list box.
       Anzahl = Anzahl + 1
       AnzahlNow = Anzahl
       DirOutline.Expand(Anzahl) = True
       DirOutline.Indent(Anzahl) = Level

       Form1.Caption = "Scan: " + CurrentPath & D(i) & "\ (" + Format(GrandTotal / 1024, "#######0") + ")"

    DoEvents
    If Terminate Then
       Exit Function
    End If

       SubTotal = AddAllInNextLevel(CurrentPath & D(i) & "\", Level + 1)


       GrandTotal = GrandTotal + SubTotal

       Ausgabe = Format(SubTotal / (1024), "######0 kB ")
       Ausgabe = String$(12 - Len(Ausgabe), " ") & Ausgabe

       DirOutline.List(AnzahlNow) = Ausgabe + D(i)' Put name in list box.


    Next i

    AddAllInNextLevel = GrandTotal + Total

    Exit Function

ErrorHandler:

    Message = "File : " + CurrentPath + DirName + " - Error : " + Error$
    Erg = MsgBox(Message, 48, "FileLen-Error")

    Resume Next
End Function

Sub Command1_Click ()
' hier wird alle Arbeit getan :
'
' Anfange mit dem Root-Directory:

    If Terminate = False Then
    Terminate = True
    Exit Sub
    End If


    Dim Path As String
    Dim Ausgabe As String
    Dim Total As Long

    Dim Count, D(), i, DirName  ' Declare variables.

    DirOutline.Clear

    Path = Left(Drive1.Drive, 2) + "\"
    Anzahl = 0

    Terminate = False

    Form1.Caption = "Scan: " + Path

    Command1.Caption = "STOP"
    Refresh

    DirOutline.AddItem Path, 0   ' Put name in list box.
    DirOutline.Expand(0) = True
    Total = AddAllInNextLevel(Path, 1)

    If Terminate = True Then
     DirOutline.Clear
    End If


    Ausgabe = Format(Total / (1024), "######0 kB ")
    Ausgabe = String$(12 - Len(Ausgabe), " ") & Ausgabe

    DirOutline.List(0) = Ausgabe + Path' Put name in list box.
    Terminate = True

    Command1.Caption = "SCAN"
    Form1.Caption = "Directory - Sizes"

End Sub

Sub DirOutline_Click ()
    If DirOutline.Expand(DirOutline.ListIndex) Then
       DirOutline.Expand(DirOutline.ListIndex) = False
    Else
       DirOutline.Expand(DirOutline.ListIndex) = True
    End If

End Sub

Sub Form_Load ()
    Terminate = True
End Sub

Sub Form_Resize ()
    If Form1.WindowState = 1 Then
    Exit Sub
    End If


    If Height < 4000 Then
    Height = 4000
    End If
    If Width < 6000 Then
    Width = 6000
    End If

    DirOutline.Height = Height - 1000
    DirOutline.Width = Width - 400
    Drive1.Width = Width - 1900
    Refresh

End Sub

Sub Form_Unload (Cancel As Integer)
    End
End Sub